home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0787.arc / LSUSORT.DOC < prev    next >
Encoding:
Text File  |  1987-05-17  |  3.4 KB  |  99 lines
  1. ================================================================
  2. Usort.Pas   Program in Turbo Pascal 3.0 for the IBM PC and 
  3.         compatibles.  From the article "Sorting out the Sorts"
  4.         by Dick Pountain, July 1987, page 275.
  5. =================================================================
  6.  
  7.  
  8. program USORT;
  9. const CR = #13;                  { carriage return character }
  10. type letters  = 'a'..'z';
  11.      wordtype = string[16];
  12.      nodeptr  = ^nodetype;
  13.      nodetype = record
  14.           info: wordtype;
  15.           next: nodeptr
  16.         end;
  17. var inputFile,outputFile: text;
  18.     inputFilename, outputFilename: string[127];
  19.     chr,firstletter: char;
  20.     sortList: array[letters] of nodeptr;         { the array of 26 lists }
  21.     i: letters;
  22.     word: wordtype;
  23. procedure InitFiles;
  24. begin           { open input and output files }
  25.   inputFilename := paramSTR(1);
  26.   Assign(inputFile,inputFilename);
  27.   Reset(inputFile);
  28.   outputFilename := paramSTR(2);
  29.   Assign(outputFile, outputFilename);
  30.   Rewrite(outputFile);
  31. end;
  32. procedure GetWord(VAR infile: text; VAR word: wordtype);
  33. begin           { read a cleaned-up word from the input file }
  34.   word := '';                           { initialize to blank }
  35.   repeat
  36.     read(infile,chr);
  37.     if chr in ['A'..'Z']              { convert all to lowercase }
  38.     then chr := char(ord(chr)+32);
  39.     if chr in ['a'..'z']              { only accept alpha characters }
  40.     then word := word+chr;               { add to word being built }
  41.   until (chr = ' ') or (chr = CR) or eof(infile)
  42. end;
  43. procedure Place(VAR list: nodeptr; word: wordtype);
  44. var p,q,newnode: nodeptr;
  45.     found: boolean;
  46. begin           { insert new word into list in sorted position only if unique }
  47.   q := nil;
  48.   p := list;                      { p points to head of list }
  49.   found := false;
  50.   while (p <> nil)                       { not end of list and }
  51.     and (not found)                 { word not already here and }
  52.     and (word >= p^.info) do        { word alphabetically later than current }
  53.     if p^.info = word              { does this node contain our word? }
  54.     then found := true                 { yes! word is already here }
  55.     else begin
  56.       q := p;                        { remember this node and }
  57.       p := p^.next                   { move on to the next one }
  58.     end; {while}
  59.   if not found                       { word isn't already here }
  60.   then begin
  61.     New(newnode);                     { create a new node }
  62.     newnode^.info := word;            { put word in its info field }
  63.     if q = nil                            { list was empty }
  64.     then begin
  65.       newnode^.next := list;                 { newnode becomes first }
  66.       list := newnode
  67.     end
  68.     else begin
  69.       newnode^.next := q^.next;                { insert after node q }
  70.       q^.next := newnode
  71.     end
  72.   end
  73. end;
  74. procedure SquirtOut(list: nodeptr; VAR outfile: text);
  75. begin           { send sorted list to output file }
  76.   while list <> nil
  77.   begin
  78.     writeln(outfile,list^.info);
  79.     list := list^.next
  80.   end
  81. end;
  82. begin           { main program }
  83.   InitFiles;
  84.   for i := 'a' to 'z' do sortList[i] := nil;      { initialize all the lists }
  85.   while not eof(inputFile) do
  86.   begin
  87.     GetWord(inputFile,word);
  88.     firstletter := word[1];                  { get first letter }
  89.     Place(sortList[firstletter],word)          { put word in proper place }
  90.   end; {while}
  91.   for i := 'a' to 'z' do SquirtOut(sortList[i],outputFile);
  92.   writeln('Keywords are contained in ',outputFilename);
  93.   Close(inputFile);
  94.   Close(outputFile)
  95. end.!ENDLISTING2!
  96.  
  97. !CAPTION!Listing 2. USORT.PAS, a text indexing program in Turbo Pascal 3.0. (Compile into a .COM file.)!ENDCAPTION!
  98.  
  99.